home *** CD-ROM | disk | FTP | other *** search
/ 1st Multimedia Mac Shareware / Multimedia Shareware CD-ROM - BetaCorp.iso / Games / Aquarium / Aquarium2.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-03-27  |  6.0 KB  |  258 lines  |  [TEXT/TPAS]
  1. { This is an attempt to duplicate the program 'Aquarium,' which takes up a
  2.     whopping 35K of disk space. My guess is that it could be done in less room.
  3.     Also, a good chance to learn about PICT resources & CopyBits calls.
  4.     The general gist is thus: 1) Open the ScrapBook file (or whichever one
  5.     has the fish PICT in it); 2) Open a window over the entire screen;
  6.     3) Move the fish around, bouncing it off of the window edges;
  7.     4) Exit when the user presses a key or clicks the mouse button.
  8.  
  9. }
  10.  
  11. PROGRAM Aquarium1;
  12.  
  13. {$U-}               {Turn normal Unit usage off}
  14. {$R-}               {Range checking off}
  15. {$T APPLAqrm}       {Type & creator}
  16.  
  17. uses MemTypes, QuickDraw, OSIntf, ToolIntf;
  18.  
  19.  
  20.  
  21. VAR {Globals}
  22.  
  23. indx,
  24. MaxWidth,
  25. MaxHeight,
  26. MinWidth,
  27. MinHeight,
  28. hdist,
  29. vdist:          integer;
  30. FishRect,
  31. r,
  32. bounds:         rect;       {for setting up the screen}
  33. WhichFish,
  34. visible:        boolean;
  35. theWindP:       WindowPtr;
  36. anevent:        eventRecord;
  37. myPort:         grafPort;
  38.  
  39. a:              boolean;
  40. thePoint:       point;
  41. PicHandle1,
  42. PicHandle2,
  43. PicHandle3,
  44. PicHandle4:     PicHandle;
  45.  
  46.  
  47.  
  48.  
  49. procedure debugger; inline $A9FF;   {crash into the debugger, not bomb box}
  50.  
  51.  
  52.  
  53. procedure crash;
  54. begin
  55.     debugger;
  56. end;
  57.  
  58.  
  59.  
  60. procedure SetUpScreen;
  61. begin
  62.     OpenPort(@myPort);
  63.     bounds:= screenbits.bounds;
  64.     theWindP:= NewWindow( nil, bounds, '', visible, rDocProc,
  65.                         Pointer(-1), True, 0);
  66.     FillRect(bounds, white);
  67. end;
  68.  
  69.  
  70. { ---------------------------------- end SetUpScreen --------------- }
  71.  
  72.  
  73.  
  74. procedure Init;
  75. begin
  76.     MoreMasters;
  77.     InitGraf(@thePort);
  78.     Randseed:= TickCount;
  79.     InitFonts;
  80.     FlushEvents(Everyevent, 0);
  81.     InitWindows;
  82.    {InitMenus;}         {We don't use them, we don't want to see them}
  83.     TEInit;
  84.     InitDialogs(@crash);
  85.     InitCursor;
  86.     PenNormal;
  87.     visible:= true;
  88.     SetUpScreen;        {get the port}
  89.     MaxWidth := MyPort.portrect.right;
  90.     MaxHeight := MyPort.portrect.bottom;
  91.     MinWidth := MyPort.portrect.left;
  92.     MinHeight := MyPort.portrect.top;
  93. end;
  94.  
  95.  
  96.  
  97. procedure ResFork;
  98. VAR
  99.     a:              boolean;
  100.     TheError,
  101.     TheRefNum:      integer;
  102.     anEvent:        EventRecord;
  103.     TheFileName:    String[63];
  104. BEGIN
  105.     a := false;
  106. (*  theRefNum := OpenResFile( 'XAquarium');     *)  {RAM only}
  107. (* *) theRefNum := CurResFile;   (* to disk ONLY *)
  108.                                 {get our appl rsrc file ref# to use}
  109.     TheError:= ResError;
  110.     If TheError <> noErr then
  111.     BEGIN
  112.         Sysbeep(5);
  113.         MoveTo(400, 18);
  114.         DrawString(' The file was not found. ');
  115.         repeat
  116.             a := GetNextEvent( keyDownMask + mDownMask, anEvent);
  117.         until a;
  118.         ExitToShell;
  119.     END {if};
  120. END;
  121.  
  122.  
  123.  
  124. PROCEDURE GetPic;
  125. var
  126.     thePic1,
  127.     thePic2,
  128.     thePic3,
  129.     thePic4     :Handle;
  130. BEGIN
  131.     thePic1 := GetResource('PICT', -32760);     {rh, reg}
  132.     thePic2 := GetResource('PICT', -32762);     {rh, up}
  133.     thePic3 := GetResource('PICT', -32763);     {lh, reg}
  134.     thePic4 := GetResource('PICT', -32761);     {lh, up}
  135.         {convert all 4 'Handles' to 'PicHandles'}
  136.     PicHandle1 := picHandle(thePic1);
  137.     PicHandle2 := picHandle(thePic2);
  138.     PicHandle3 := picHandle(thePic3);
  139.     PicHandle4 := picHandle(thePic4);
  140.     if PicHandle1 = NIL then 
  141.         BEGIN
  142.             SysBeep( 5);
  143.             ExitToShell;
  144.         END;
  145.     if PicHandle2 = NIL then 
  146.         BEGIN
  147.             SysBeep( 5);
  148.             ExitToShell;
  149.         END;
  150.     if PicHandle3 = NIL then 
  151.         BEGIN
  152.             SysBeep( 5);
  153.             ExitToShell;
  154.         END;
  155.     if PicHandle4 = NIL then 
  156.         BEGIN
  157.             SysBeep( 5);
  158.             ExitToShell;
  159.         END;
  160. END;
  161.  
  162.  
  163.  
  164. FUNCTION SetHDist: integer;
  165. VAR
  166.     newx:   integer;
  167. BEGIN
  168.     newx:= abs(random) mod 7 * 2;
  169.     if newx = 0 then newx:= newx + 2;
  170.     SetHDist:= newx;
  171. END;
  172.  
  173.  
  174.  
  175. FUNCTION SetVDist: integer;
  176. VAR
  177.     newx:   integer;
  178. BEGIN
  179.     newx:= abs(random) mod 4 * 2;
  180.     if newx = 0 then newx:= newx + 2;
  181.     SetVDist:= newx;
  182. END;
  183.  
  184.  
  185.  
  186. PROCEDURE TestEdges;
  187. BEGIN
  188.         If FishRect.left >= MaxWidth - 30 then hdist:= -SetHDist; {neg}
  189.         If FishRect.top >= MaxHeight - 16 then vdist:= -SetVDist; {neg}
  190.         If FishRect.right <= MinWidth + 30 then hdist:= SetHDist; {pos}
  191.         If FishRect.bottom <= MinHeight + 16 then vdist:= SetVDist; {pos}
  192. END;
  193.  
  194.  
  195.  
  196. PROCEDURE DrawTheFish( VAR FishRect: rect);
  197. VAR
  198.     TitlePoint,
  199.     TitlePoint1:        point;
  200. BEGIN
  201.     OffSetRect(Fishrect, hDist, vDist);     {move the actual rect coords}
  202.     IF WhichFish then                      {draw fish on screen}
  203.         if hdist > 0 then                           {right-going fish}
  204.             DrawPicture( PicHandle1, FishRect)      {rh reg}
  205.         else                                        {left-going fish}
  206.             DrawPicture( PicHandle3, FishRect)      {lh reg}
  207.     ELSE
  208.         if hdist > 0 then
  209.             DrawPicture( PicHandle2, FishRect)      {rh up}
  210.         else
  211.             DrawPicture( PicHandle4, FishRect);     {lh up}
  212.     WhichFish := NOT WhichFish;
  213.     TitlePoint.h := 224;
  214.     TitlePoint.v := 20;
  215.     TitlePoint1.h := 290;
  216.     TitlePoint1.v := 20;
  217.     IF NOT( PtInRect( TitlePoint, FishRect) OR PtInRect( TitlePoint1, FishRect))
  218.         THEN
  219.         BEGIN
  220.             MoveTo(225, 18);
  221.             TextFont(0);    {Chicago}
  222.             TextSize(12);
  223.             TextFace([underline]);
  224.             DrawString('Aquarium');
  225.         END;                        {if IN TitleRect, don't draw}
  226. END;
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233. BEGIN       {------------- MAIN PROGRAM LOOP ---------------}
  234.     Init;
  235.     HideCursor;
  236.     TextFont(1);
  237.     TextSize(9);
  238.     ResFork;            {open the Rsrc file}
  239.     GetPic;             {get the fish PICT resources into handles}
  240.     hDist := SetHDist;
  241.     vDist := SetVDist;
  242.     WhichFish := true;
  243.     SetRect( FishRect, 1, 1, 302, 163);     {starting fish place} 
  244.     a := false;
  245.     
  246.     
  247.     while not a DO
  248.     begin
  249.         TestEdges;
  250.         DrawTheFish( FishRect);
  251.         a:=getNextEvent(mDownMask + keyDownMask, anEvent);
  252.  
  253.             {we've now gotten a key or mouse event, so end}
  254.  
  255.     END;  {while not A...}
  256.     ShowCursor;
  257. END.
  258.